home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Compiler.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-12-01  |  6.8 KB  |  195 lines  |  [TEXT/.Ob4]
  1. Syntax12b.Scn.Fnt
  2. Syntax12.Scn.Fnt
  3. Syntax12i.Scn.Fnt
  4. Syntax10.Scn.Fnt
  5. MODULE Compiler;    (* RC 6.3.89 / 16.10.92, mmb 19.2.93 / 31.5.94 *)
  6. (* 94-05-24 OptionChar changed *) (* MAH 20.7.94 Debugger interface*)
  7.     IMPORT
  8.         Texts, TextFrames, Viewers, Oberon,
  9.         OPP := POPP, OPB := POPB, OPV := POPV, OPT := POPT,
  10.         OPS := POPS, OPC := POPC, OPL := POPL, OPM := POPM;
  11.     CONST
  12.         OptionChar = "/";
  13.         (* compiler options: *)
  14.         inxchk* = 0;    (* x - index check on *)
  15.         ovflchk* = 1;    (* v - overflow check on *)
  16.         ranchk* = 2;    (* r- range check on *)
  17.         typchk* = 3;    (* t - type check on *)
  18.         newsf* = 4;    (* s- generation of new symbol file allowed *)
  19.         ptrinit* = 5;    (* p - pointer initialization *)
  20.         intprinf* = 6;    (* inter-procedural information about register allocation used *)
  21.         nilchk* = 7;    (* n - nil pointer checks on read accesses *)
  22.         assert* = 8;    (* a - assert evaluation *)
  23.         findpc* = 9;    (* f - find text position of breakpc *)
  24.         powerpc* = 10;    (* c - use PowerPC instruction set *)
  25.         now301 = 11; (* w - supress warning 301 *)
  26.         defopt* = {inxchk, typchk, nilchk, ptrinit, assert, powerpc};    (* default options *)
  27.         ShowCommand = "POPdump.ShowProg";
  28.         SignOnMessage = "Compiler  RC / MB 31.5.94";
  29.         prog*: OPT.Node;
  30.         showTree, watch: BOOLEAN;
  31.         (* global because of the GC call on Ceres*)
  32.         source: Texts.Text;
  33.         sourceR: Texts.Reader;
  34.         S: Texts.Scanner;
  35.         v: Viewers.Viewer;
  36.         W: Texts.Writer;
  37.         mainMod*: OPT.Object;    (*<<<< MAH 20.7.94 *)
  38.     PROCEDURE Module* (source: Texts.Reader; options: ARRAY OF CHAR; breakpc: LONGINT; log: Texts.Text;
  39.                                         VAR error: BOOLEAN);
  40.         VAR
  41.             key: LONGINT; opt: SET; ch: CHAR; newSF: BOOLEAN;
  42.             p: OPT.Node; modName: OPS.Name;
  43.             res, i: INTEGER;
  44.             command: ARRAY 32 OF CHAR;
  45.     BEGIN
  46.         IF watch THEN command := "System.Watch"; Oberon.Call(command, Oberon.Par, FALSE, res) END ;
  47.         opt := defopt; i := 0;
  48.         REPEAT
  49.             ch := options[i]; INC(i);
  50.             IF ch = "x" THEN opt := opt / {inxchk}
  51.             ELSIF ch = "v" THEN opt := opt / {ovflchk}
  52.             ELSIF ch = "r" THEN opt := opt / {ranchk}
  53.             ELSIF ch = "t" THEN opt := opt / {typchk}
  54.             ELSIF ch = "n" THEN opt := opt / {nilchk}
  55.             ELSIF ch = "p" THEN opt := opt / {ptrinit}
  56.             ELSIF ch = "a" THEN opt := opt / {assert}
  57.             ELSIF ch = "s" THEN opt := opt / {newsf}
  58.             ELSIF ch = "f" THEN opt := opt / {findpc}
  59.             ELSIF ch = "c" THEN opt := opt / {powerpc}
  60.             ELSIF ch = "w" THEN INCL (opt, now301)
  61.             END
  62.         UNTIL ch = 0X;
  63.         OPM.Init(source, log); OPS.Init; OPT.Init; OPB.typSize := OPV.TypSize;
  64.         newSF := newsf IN opt;
  65.         IF now301 IN opt THEN OPM.err (-10000) END;
  66.         OPT.OpenScope(0, NIL);
  67.         OPP.Module(p, modName);
  68.         IF findpc IN opt THEN mainMod:=OPT.topScope; ELSE mainMod:=NIL; END;    (*<<<< MAH 21.06.94 *)
  69.         IF OPM.noerr THEN
  70.             OPL.Init(opt); OPV.Init(opt, breakpc);
  71.             OPV.AdrAndSize(OPT.topScope);
  72.             OPM.errpos := 0;
  73.             key := OPM.NewKey();
  74.             OPT.Export(modName, newSF, key);
  75.             IF newSF THEN OPM.LogWStr(" new symbol file") END ;
  76.             IF showTree THEN prog := p; command := ShowCommand;
  77.                 Oberon.Call(command, Oberon.Par, FALSE, res); prog := NIL
  78.             END ;
  79.             IF OPM.noerr THEN
  80.                 OPM.OpenRefObj(modName);
  81.                 OPC.Init(opt);
  82.                 OPV.Module(p);
  83.                 IF OPM.noerr THEN
  84.                     OPL.OutCode(modName, key);
  85.                     IF OPM.noerr THEN
  86.                         OPM.CloseRefObj; OPM.LogWNum(4*OPL.pc, 8); OPM.LogWNum(OPL.dsize, 8)
  87.                     END
  88.                 END
  89.             END ;
  90.             OPL.Close
  91.         END ;
  92.         OPT.CloseScope; OPT.Close;
  93.         OPM.LogWLn; error := ~OPM.noerr;
  94.         IF watch THEN command := "System.Watch"; Oberon.Call(command, Oberon.Par, FALSE, res) END
  95.     END Module;
  96.     PROCEDURE Compile*;
  97.         VAR beg, end, time: LONGINT; error: BOOLEAN; ch: CHAR;
  98. vv:Viewers.Viewer;
  99.         PROCEDURE Do(filename: ARRAY OF CHAR; beg: LONGINT);
  100.             VAR S1: Texts.Scanner; line, i: INTEGER; options: ARRAY 32 OF CHAR;
  101.                 fbeg, fend, ftime, breakpc: LONGINT; ftext: Texts.Text; f: BOOLEAN;
  102.         BEGIN
  103.             Texts.WriteString(W, filename); Texts.WriteString(W, "  compiling  ");
  104.             Texts.OpenScanner(S1, source, beg);
  105.             REPEAT
  106.                 Texts.Scan(S1)
  107.             UNTIL S1.eot OR ((S1.class = Texts.Name) & (S1.s = "MODULE"));
  108.             IF ~S1.eot THEN
  109.                 Texts.Scan(S1);
  110.                 IF S1.class = Texts.Name THEN Texts.WriteString(W, S1.s) END
  111.             END ;
  112.             Texts.Append(Oberon.Log, W.buf);
  113.             line := S.line; i := 0; f := FALSE;
  114.             Texts.Scan(S);
  115.             IF (S.line = line) & (S.class = Texts.Char) & (S.c = OptionChar) THEN
  116.                 ch := S.nextCh;
  117.                 WHILE ((ch >= "0") & (ch <= "9") OR (ch >= "a") & (ch <= "z")) & (i < LEN(options) - 1) DO
  118.                     options[i] := ch; INC(i);
  119.                     IF ch = "f" THEN f := ~f END ;
  120.                     Texts.Read(S, ch)
  121.                 END ;
  122.                 S.nextCh := ch;
  123.                 Texts.Scan(S)
  124.             END ;
  125.             options[i] := 0X;
  126.             IF f THEN
  127.                 LOOP
  128.                     Oberon.GetSelection(ftext, fbeg, fend, ftime);
  129.                     IF ftime >= 0 THEN
  130.                         Texts.OpenScanner(S1, ftext, fbeg); Texts.Scan(S1);
  131.                         IF S1.class = Texts.Int THEN breakpc := S1.i; EXIT END
  132.                     END ;
  133.                     Texts.WriteString(W, "  pc not selected"); Texts.WriteLn(W);
  134.                     Texts.Append(Oberon.Log, W.buf); error := TRUE; RETURN
  135.                 END
  136.             END ;
  137.             Texts.OpenReader(sourceR, source, beg);
  138.             Module(sourceR, options, breakpc, Oberon.Log, error)
  139.         END Do;
  140.     BEGIN
  141.         error := FALSE;
  142.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  143.         IF S.class = Texts.Char THEN
  144.             IF S.c = "*" THEN
  145.                 v := Oberon.MarkedViewer();
  146. vv:=v;
  147.                 IF (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  148.                     source := v.dsc.next(TextFrames.Frame).text; Do("", 0)
  149.                 END
  150.             ELSIF S.c = "^" THEN
  151.                 Oberon.GetSelection(source, beg, end, time);
  152.                 IF time >= 0 THEN
  153.                     Texts.OpenScanner(S, source, beg); Texts.Scan(S); NEW(source); 
  154.                     WHILE (S.class = Texts.Name) & (Texts.Pos(S) - S.len <= end) & ~error DO
  155.                         Texts.Open(source, S.s);
  156.                         IF source.len # 0 THEN Do(S.s, 0)
  157.                         ELSE
  158.                             Texts.WriteString(W, S.s); Texts.WriteString(W, " not found");
  159.                             Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); error := TRUE
  160.                         END
  161.                     END
  162.                 END
  163.             ELSIF S.c = "@" THEN
  164.                 Oberon.GetSelection(source, beg, end, time);
  165.                 IF time >= 0 THEN Do("", beg) END
  166.             END
  167.         ELSE NEW(source);
  168.             WHILE (S.class = Texts.Name) & ~error DO
  169.                 Texts.Open(source, S.s);
  170.                 IF source.len # 0 THEN Do(S.s, 0)
  171.                 ELSE
  172.                     Texts.WriteString(W, S.s); Texts.WriteString(W, " not found");
  173.                     Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); error := TRUE
  174.                 END
  175.             END
  176.         END ;
  177.         Oberon.Collect(0)
  178.     END Compile;
  179.     PROCEDURE ShowTree*;
  180.     BEGIN showTree := TRUE
  181.     END ShowTree;
  182.     PROCEDURE HideTree*;
  183.     BEGIN showTree := FALSE
  184.     END HideTree;
  185.     PROCEDURE DoWatch*;
  186.     BEGIN watch := TRUE
  187.     END DoWatch;
  188.     PROCEDURE DontWatch*;
  189.     BEGIN watch := FALSE
  190.     END DontWatch;
  191. BEGIN
  192.     HideTree; DontWatch; prog := NIL; Texts.OpenWriter(W);
  193.     Texts.WriteString(W, SignOnMessage); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  194. END Compiler.
  195.